perm filename XPITCH.SAI[X,ALS] blob
sn#088678 filedate 1974-02-25 generic text, type T, neo UTF8
00010 BEGIN "XRUN"
00020 DEFINE ⊂="COMMENT";
00030
00040 ⊂ This program runs another program, BXX, as a separate job and produces
00050 an XGP plot of formant data from the specified file. This program may
00060 be executed directly, in which case it requests info from the TTY, or it
00070 be called into being as a separate job and passed a number specifying
00080 the file to be used. In this second case this program automatically
00090 kills its job on completion;
00100
00110 DEFINE ⊃="⊂";
00120 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130 INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN3,CHAN5,CHAN1,EOFT,EOF,BRCHR,
00140 PP,POINTP,FLAG,MUTE,NUM,ITT,KTT,JTT,SCALE;
00150 STRING FILEP,FILEN,FILEM,READ1,READ,READTT,TFILE,MEMO; BOOLEAN ER;
00160 INTEGER ARRAY SAVE,JHSAVE[0:6];
00170 INTEGER ARRAY LFILE[0:127];
00180 INTEGER ARRAY NEW,BUFTT[0:511];
00190 INTEGER ARRAY DPYBUF[0:4096];
00200 INTEGER A1,A2,A3;
00210 LABEL STARTP;
00220 INTEGER DATE,TIME;
00230 DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00240 PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00250 "SEP","OCT","NOV","DEC";
00260 STRING ARRAY MONTHS[0:11];
00270
00280 INTERNAL STRING PROCEDURE DATIM;
00290 BEGIN
00300 INTEGER DAY,YR,HRS,MIN,SEC;
00310 DAY←(DATE MOD 31)+1;DATE←DATE%31;
00320 YR←1964+DATE%12; SEC←TIME MOD 60;
00330 TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00340 SETFORMAT(-2,0);
00350 RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00360 "-"&CVS(YR)&" "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00370 END;
00380
00390 PROCEDURE DTTTIN;
00400 BEGIN
00410 INTEGER J;
00420 FOR I←0 STEP 1 UNTIL 511 DO BUFTT[I]←0;
00430 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512);
00440 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00450 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00460 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00470 END;
00480
00490
00500 INTERNAL STRING PROCEDURE WTIM;
00510 BEGIN
00520 DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00530 RETURN(DATIM);
00540 END;
00550
00560 INTERNAL STRING PROCEDURE DATIME;
00570 BEGIN
00580 GETIME;
00590 RETURN(DATIM);
00600 END;
00610
00620
00625 ⊂ If scale is 32 we allow;
00630 ⊂ 1140 units on a line corresponding to 76 charactters @15 units,
00640 380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00650
00660
00670 PROCEDURE XPLOT;
00680 BEGIN "XPLOT"
00690 REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00700 REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00710 REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00720 EXTERNAL FORTRAN PROCEDURE XSET;
00730 EXTERNAL FORTRAN PROCEDURE XRVEC;
00740 EXTERNAL FORTRAN PROCEDURE XVEC;
00750 EXTERNAL FORTRAN PROCEDURE XIVEC;
00760 EXTERNAL FORTRAN PROCEDURE XIRVEC;
00770 EXTERNAL FORTRAN PROCEDURE XLINE;
00780 EXTERNAL FORTRAN PROCEDURE VERTAX;
00790 EXTERNAL FORTRAN PROCEDURE SWT25;
00800 EXTERNAL FORTRAN PROCEDURE PTX1;
00810 EXTERNAL FORTRAN PROCEDURE XOUT;
00820 EXTERNAL FORTRAN PROCEDURE XFIN;
00830 INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00840 INTEGER XX,IX,IX2,IY,XREF,YREF,X2,Y2,HT,XSAVE,XCUT;
00850 INTEGER MIN,MAX,ERR;
00860 MIN←0;
00870 MAX←3500;
00880 XREF←400;
00890 YREF←200;
00900 HT←700; ⊂ Allowing 5 inches for 5000 hertz;
00910 XSET;
00920
00930 SCALE←20
00935 ; ⊂ Inverse to size, 32 was standard;
00940
00960 XSAVE←0;
00970
00980 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
00990 LOOKUP(CHAN5,FILEN,ERR);
01000 IF ERR THEN OUTSTR("FILE "&FILEP&" NOT FOUND"&CRLF);
01010 ARRYIN(CHAN5,LFILE[0],'200);
01020
01030 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
01040 LOOKUP(CHAN5,FILEP,ERR);
01050 FILEINFO(SAVE);
01060 IF ERR THEN OUTSTR("FILE "&FILEP&" NOT FOUND"&CRLF);
01070
01080 XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
01090 IX←XREF; IY←100; SWT25(IX,IY);
01100 READ←WTIM; SETFORMAT(1,0);
01110
01120 XSTR←"Glottal pulse determination in file "
01130 &FILEP&" (created "&READ&")";
01140 IX←XREF; IY← 1450; SWT25(IX,IY);
01150 XSTR←"with plot of determining rule (0 through 7) "&MEMO;
01160 IX←XREF+100; IY←1420; SWT25(IX,IY);
01170 XSTR←"Compared with pitch markers from file "&filem&" (created "
01175 &READTT&")";
01180 IX←XREF; IY←1390; SWT25(IX,IY);
01190 XSTR←"A.I. Laboratory, Stanford University. "&DATIME;
01200 IX←XREF+200; IY←1360; SWT25(IX,IY);
01201 XSTR←"7"; IX←XREF-20; IY←YREF+950-13+7*25; SWT25(IX,IY);
01202 XSTR←"6"; IY←YREF+950-13+6*25; SWT25(IX,IY);
01203 XSTR←"5"; IY←YREF+950-13+5*25; SWT25(IX,IY);
01204 XSTR←"4"; IY←YREF+950-13+4*25; SWT25(IX,IY);
01205 XSTR←"3"; IY←YREF+950-13+3*25; SWT25(IX,IY);
01206 XSTR←"2"; IY←YREF+950-13+2*25; SWT25(IX,IY);
01207 XSTR←"1"; IY←YREF+950-13+1*25; SWT25(IX,IY);
01208 XSTR←"0"; IY←YREF+950-13+0*25; SWT25(IX,IY);
01209 XOUT(XREF-8);
01210
01220 FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01230 IF LFILE[I]=0 THEN DONE;
01240 L←LFILE[I] LAND '777760000000;
01250 J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01260
01270 X←J*128%SCALE+K*64%SCALE-8; ⊂ X←(J+K%2)*128%SCALE-8;
01277
01280 IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01290 IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01300 IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01310 IY←YREF-70; SWT25(IX,IY); END;
01320
01330 IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01340 XLINE(IX,YREF-20,IX,YREF);
01350 XLINE(IX,YREF,IX2,YREF);
01360 XLINE(IX,YREF-1,IX2,YREF-1);
01370 XLINE(IX,YREF-2,IX2,YREF-2);
01380 XLINE(IX2,YREF,IX2, YREF-20);
01390
01400 END "PONY";
01410 OUTSTR("Text,");
01480
01490 XCUT←IX2+200;
01500
01510
01540 LY←YREF+950; LX←XREF; XIVEC(LX,LY);
01550
01555 I←0; IX←XREF; IY←LY-30; XSTR←"Time in seconds→"; SWT25(IX,IY);
01556 SETFORMAT(1,0);
01558
01560 FOR X←XREF STEP 2000%SCALE UNTIL IX2 DO BEGIN
01561 XLINE(X,LY+7*25,X+2,LY+7*25);
01562 XLINE(X,LY+6*25,X+6,LY+6*25);
01563 XLINE(X,LY+5*25,X+2,LY+5*25);
01564 XLINE(X,LY+4*25,X+6,LY+4*25);
01565 XLINE(X,LY+3*25,X+2,LY+3*25);
01566 XLINE(X,LY+2*25,X+6,LY+2*25);
01567 XLINE(X,LY+1*25,X+2,LY+1*25);
01568 XLINE(X,LY,X+6,LY);
01571 IF ((I MOD 10)=0)∧(I≠0) THEN BEGIN
01572 J←I%10; XSTR←CVS(J); IX←X-8; IY←LY-30; SWT25(IX,IY); END;
01573 I←I+1;
01574 END;
01576 IY←YREF+600;
01580
01590 WHILE EOF=0 DO BEGIN "XDATIN"
01600 FOR I←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01610 ARRYIN(CHAN5,NEW[0],512);
01620 IF NEW[0]=0 THEN DONE "XDATIN";
01630
01645
01650
01660
01680 FOR J←0 STEP 2 UNTIL 510 DO BEGIN
01690 IF NEW[J]=0 THEN DONE;
01700 XX←(NEW[J] LSH -15); X←XX%SCALE+XREF;
01701
01702 Y←(NEW[J] LAND '7)*25;
01703 XVEC(LX,LY+Y); XVEC(X,LY+Y); LX←X;
01710
01740 IF (LDB(POINT(3,NEW[J],35))≠0) THEN BEGIN
01750 Y←LDB(POINT(13,NEW[J],33))%20; XLINE(X,IY,X,Y+IY);
01760 Y←LDB(POINT(13,NEW[J+1],12))%10; XLINE(X,YREF,X,YREF+Y);
01770 END ELSE XLINE(X,IY,X,IY+2);
01775 WHILE (K←(BUFTT[KTT] LSH -15)%SCALE+XREF)≤X DO BEGIN
01777 Y←(BUFTT[KTT] LAND '77777)%100;
01779 XLINE(K,IY,K,IY-Y);
01781 KTT←KTT+1; IF KTT≥512 THEN DTTTIN; END;
01783
01784 IF (J MOD 64)=0 THEN BEGIN
01785 XOUT(X-100); OUTSTR(CVS(X)&",");
01810 END;
01815 END;
01820
01850 END "XDATIN";
01860 CLOSE(CHAN5);
01870 XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
01880 IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
01890
01900 XFIN;
01910 END "XPLOT";
01920
00010 CHAN1←1; CHAN3←3; CHAN5←5;
00020 STDBRK(1);
00030 STARTP:
00040 MUTE←60; NUM←3;
00050 CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00060 LOOKUP(CHAN1,"NUMBER.TMP",ER);
00070 IF ER THEN BEGIN
00080 OUTSTR("The following set-up commands of a letter followed by a number "
00090 &"may be given:"&CRLF);
00100 OUTSTR(" M# sets MUTE level (default value 60)"&CRLF&
00110 " N# sets number of formants (default value 3)."&CRLF);
00120 OUTSTR("A number only uses preset values for M and N and specifies the file to use."
00130 &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00140 SETFORMAT(1,0); FLAG←0; X←0;
00150 WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command "); READ←INCHWL;
00160 IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00170 IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00180 DONE; END "TYPE";
00190 IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00200 END ELSE BEGIN
00210 PP←CVD(INPUT(CHAN1,1));
00220 CLOSE(CHAN1);
00230 END;
00240
00242 FILEN←"SEG"&CVS(PP)&".SYN[2,JH]";
00244 FILEP←"SEG"&CVS(PP)&".ASP[SYN,ALS]";
00246 FILEM←"SEG"&CVS(PP)&".T[PIT,NJM]";
00247
00248 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00250 LOOKUP(CHAN3,FILEM,ER); TFILE←FILEM;
00251 FILEINFO(SAVE); READTT←WTIM;
00252 IF ER THEN BEGIN
00254 OUTSTR("File "&FILEM&" not found (S to start, space bar to ignore) ");
00256 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00258 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00260 CLRBUF; END; END;
00261 DTTTIN; CLOSE(CHAN3);
00262
00264 XPLOT;
00280 PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF);
00300
00310 END "XRUN";